home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Modules / fut-sel.em < prev    next >
Lisp/Scheme  |  1993-07-12  |  3KB  |  112 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;                                                                           ;;
  9. ;;   EuLisp Module  -   Copyright (C) Codemist and University of Bath 1989   ;;
  10. ;;                                                                           ;;
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13.  
  14. ;;
  15.  
  16. ;; Change Log:
  17. ;;   Version 1.0 (20/5/90)
  18.  
  19. ;; added Future-select
  20.  
  21. (defmodule fut-sel
  22.  
  23.   (eulisp0 futures)()
  24.  
  25.   (defstruct Future-Selector ()
  26.     ((comm-sem initform (make-semaphore)
  27.            accessor Future-Selector-comm-sem)
  28.      (lock-sem initform (make-semaphore)
  29.            accessor Future-Selector-lock-sem)
  30.      (result-future initform () 
  31.             accessor Future-Selector-result-future))
  32.     constructor make-Future-Selector)
  33.     
  34.   (defmethod initialize-instance ((proto Future-Selector) lst)
  35.     (let ((new-obj (call-next-method)))
  36.       (open-semaphore (Future-Selector-comm-sem new-obj))
  37.       new-obj))
  38.  
  39.   (defun make-future-selector (futs)
  40.     (let ((fs (make-Future-Selector)))
  41.       (mapc (lambda (fut) (thread-start (make-thread future-select-aux)
  42.                     fut fs))
  43.         futs)
  44.       fs))
  45.  
  46.   ;; returns next future + reinitialises the sem.
  47.   (defun select-future (fs)
  48.     (open-semaphore (Future-Selector-comm-sem fs))
  49.     (let ((result (Future-Selector-result-future fs)))
  50.       ((setter Future-Selector-result-future) fs nil)
  51.       result))
  52.  
  53.   (defun select-one-future (futs)
  54.     (let ((fs (make-Future-Selector)))
  55.       (mapc (lambda (fut)
  56.           (thread-start (make-thread future-select-aux)
  57.                 fut fs))
  58.         futs)
  59.       (open-semaphore (Future-Selector-comm-sem fs))
  60.       (Future-Selector-result-future fs)))
  61.   
  62.   (defun future-select-aux (fut fs)
  63.     (let ((value (future-value fut)))
  64.       (open-semaphore (Future-Selector-lock-sem fs))
  65.       (cond ((Future-Selector-result-future fs)
  66.          (close-semaphore (Future-Selector-lock-sem fs))
  67.          (thread-reschedule)
  68.          (future-select-aux fut fs)
  69.          nil)
  70.         (t ((setter Future-Selector-result-future) fs fut)
  71.            (close-semaphore (Future-Selector-comm-sem fs))           
  72.            (close-semaphore (Future-Selector-lock-sem fs))
  73.            fut))))
  74.   ;;
  75.   ;; Test...
  76.   ;;
  77.  
  78.   (defun fibbing (x y)
  79.     (thread-reschedule)
  80.     (if (< x 2) y
  81.       (and (fibbing (- x 1) y)
  82.        (progn (thread-reschedule) t)
  83.        (fibbing (- x 2) y))))
  84.  
  85.   
  86.   (defun mk-tasks (n) 
  87.     (cond ((= n 0) 
  88.        ())
  89.       (t (let ((x  (remainder (c-rand) 16)))
  90.            (format t "Task: ~a%" x)
  91.            (cons (future (fibbing x x))
  92.              (mk-tasks (- n 1)))))))
  93.  
  94.   (defun get-results (sel n)
  95.     (if (= n 0)
  96.     ()
  97.       (progn (format t "Result: ~a~%" (future-value (select-future sel)))
  98.          (get-results sel (- n 1)))))
  99.   
  100.  
  101.   (defun test (n) 
  102.     (get-results (make-future-selector (mk-tasks n)) n))
  103.  
  104.   
  105.  
  106.      
  107.   (defun future-done-p (fut) (future-object-done fut))
  108.  
  109.   (export make-future-selector future-select)
  110.  
  111. )
  112.